home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 18 / CU Amiga Magazine's Super CD-ROM 18 (1997)(EMAP Images)(GB)[!][issue 1998-01].iso / CUCD / Programming / AmigaE / Src / Rkrm / Graphics_Libraries / Text / availfonts.e next >
Encoding:
Text File  |  1995-09-20  |  9.5 KB  |  273 lines
  1. -> AvailFonts.e
  2.  
  3. ->>> Header (globals)
  4. MODULE 'diskfont',
  5.        'layers',
  6.        'utility',
  7.        'exec/nodes',
  8.        'exec/ports',
  9.        'graphics/rastport',
  10.        'graphics/gfx',
  11.        'graphics/text',
  12.        'intuition/intuition',
  13.        'intuition/screens',
  14.        'libraries/diskfont'
  15.  
  16. ENUM ERR_NONE, ERR_DRAW, ERR_LIB, ERR_REGN, ERR_WIN
  17.  
  18. RAISE ERR_DRAW IF GetScreenDrawInfo()=NIL,
  19.       ERR_LIB  IF OpenLibrary()=NIL,
  20.       ERR_REGN IF NewRegion()=NIL,
  21.       ERR_WIN  IF OpenWindowTagList()=NIL
  22.  
  23. OBJECT stringobj
  24.   string
  25.   charcount
  26.   stringwidth
  27. ENDOBJECT
  28.  
  29. DEF alphabetstring, fname:stringobj, fheight:stringobj, xDPI:stringobj,
  30.     yDPI:stringobj, entrynum:stringobj
  31. DEF mywin=NIL:PTR TO window, mycliprp, myrp:rastport
  32. DEF myrect:rectangle, new_region=NIL, old_region
  33. DEF mydrawinfo=NIL:PTR TO drawinfo, afh=NIL:PTR TO afh, fontheight,
  34.     alphabetcharcount, stringwidth
  35. ->>>
  36.  
  37. ->>> PROC main()
  38. PROC main() HANDLE
  39.   DEF defaultfont=NIL, defaultfontattr, afsize, afshortage, cliprectside
  40.   -> E-Note: use the STRLEN short-cut to get string lengths.
  41.   alphabetstring:='ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
  42.   alphabetcharcount:=STRLEN
  43.   defaultfontattr:=['topaz.font', 9, 0, 0]:textattr
  44.   fname.string:='Font Name:  ';      fname.charcount:=STRLEN
  45.   fheight.string:='Font Height:  ';  fheight.charcount:=STRLEN
  46.   xDPI.string:='X DPI:  ';           xDPI.charcount:=STRLEN
  47.   yDPI.string:='Y DPI:  ';           yDPI.charcount:=STRLEN
  48.   entrynum.string:='Entry #:  ';     entrynum.charcount:=STRLEN
  49.   KickVersion(37)
  50.   diskfontbase:=OpenLibrary('diskfont.library', 37)
  51.   layersbase:=OpenLibrary('layers.library', 37)
  52.   utilitybase:=OpenLibrary('utility.library', 37)
  53.   mywin:=OpenWindowTagList(NIL, [WA_SMARTREFRESH, TRUE,  -> Open that window.
  54.                                  WA_SIZEGADGET,   FALSE,
  55.                                  WA_CLOSEGADGET,  TRUE,
  56.                                  WA_IDCMP,        IDCMP_CLOSEWINDOW,
  57.                                  WA_DRAGBAR,      TRUE,
  58.                                  WA_DEPTHGADGET,  TRUE,
  59.                                  WA_TITLE,        'AvailFonts() example',
  60.                                  NIL])
  61.   -> An object copy: clone my window's rastport.  This rastport will be used
  62.   -> to render the font specs, not the actual font sample.
  63.   CopyMem(mywin.rport, myrp, SIZEOF rastport)
  64.   mydrawinfo:=GetScreenDrawInfo(mywin.wscreen)
  65.   SetFont(myrp, mydrawinfo.font)
  66.  
  67.   myrect.minx:=mywin.borderleft  -> LAYOUT THE WINDOW
  68.   myrect.miny:=mywin.bordertop
  69.   myrect.maxx:=mywin.width-(mywin.borderright+1)
  70.   myrect.maxy:=mywin.height-(mywin.borderbottom+1)
  71.  
  72.   cliprectside:=(myrect.maxx-myrect.minx)/20
  73.  
  74.   fontheight:=myrp.font.ysize+2
  75.   -> If the default screen font is more than one-sixth the size of the window,
  76.   -> use topaz-9.
  77.   IF fontheight>((myrect.maxy-myrect.miny)/6)
  78.     defaultfont:=OpenFont(defaultfontattr)
  79.     SetFont(myrp, defaultfont)
  80.     fontheight:=myrp.font.ysize+2
  81.   ENDIF
  82.  
  83.   fname.stringwidth:=TextLength(myrp, fname.string, fname.charcount)
  84.   fheight.stringwidth:=TextLength(myrp, fheight.string, fheight.charcount)
  85.   xDPI.stringwidth:=TextLength(myrp, xDPI.string, xDPI.charcount)
  86.   yDPI.stringwidth:=TextLength(myrp, yDPI.string, yDPI.charcount)
  87.   entrynum.stringwidth:=TextLength(myrp, entrynum.string, entrynum.charcount)
  88.  
  89.   -> What is the largest string length?
  90.   stringwidth:=Max(Max(Max(Max(fname.stringwidth, fheight.stringwidth),
  91.                    xDPI.stringwidth), yDPI.stringwidth), entrynum.stringwidth)
  92.   stringwidth:=stringwidth+mywin.borderleft
  93.  
  94.   -> If the stringwidth is more than half the viewing area, quit because the
  95.   -> font is just too big.
  96.   IF stringwidth<((myrect.maxx-myrect.minx)/2)
  97.     SetAPen(myrp, mydrawinfo.pens[TEXTPEN])
  98.     SetDrMd(myrp, RP_JAM2)
  99.  
  100.     Move(myrp, myrect.minx+8+stringwidth-fname.stringwidth,
  101.                myrect.miny+4+myrp.font.baseline)
  102.     Text(myrp, fname.string, fname.charcount)
  103.  
  104.     Move(myrp, myrect.minx+8+stringwidth-fheight.stringwidth,
  105.                myrp.cp_y+fontheight)
  106.     Text(myrp, fheight.string, fheight.charcount)
  107.  
  108.     Move(myrp, myrect.minx+8+stringwidth-xDPI.stringwidth,
  109.                myrp.cp_y+fontheight)
  110.     Text(myrp, xDPI.string, xDPI.charcount)
  111.  
  112.     Move(myrp, myrect.minx+8+stringwidth-yDPI.stringwidth,
  113.                myrp.cp_y+fontheight)
  114.     Text(myrp, yDPI.string, yDPI.charcount)
  115.  
  116.     Move(myrp, myrect.minx+8+stringwidth-entrynum.stringwidth,
  117.                myrp.cp_y+fontheight)
  118.     Text(myrp, entrynum.string, entrynum.charcount)
  119.  
  120.     myrect.minx:=myrect.minx+cliprectside
  121.     myrect.maxx:=myrect.maxx-cliprectside
  122.     myrect.miny:=myrect.miny+(5*fontheight)+8
  123.     myrect.maxy:=myrect.maxy-8
  124.  
  125.     -> Draw a box around the cliprect
  126.     SetAPen(myrp, mydrawinfo.pens[SHINEPEN])
  127.     Move(myrp, myrect.minx-1, myrect.maxy+1)
  128.     Draw(myrp, myrect.maxx+1, myrect.maxy+1)
  129.     Draw(myrp, myrect.maxx+1, myrect.miny-1)
  130.  
  131.     SetAPen(myrp, mydrawinfo.pens[SHADOWPEN])
  132.     Draw(myrp, myrect.minx-1, myrect.miny-1)
  133.     Draw(myrp, myrect.minx-1, myrect.maxy)
  134.  
  135.     SetAPen(myrp, mydrawinfo.pens[TEXTPEN])
  136.     -> Fill up a buffer with a LIST of the available fonts.
  137.     afsize:=AvailFonts(afh, 0,
  138.                        AFF_MEMORY OR AFF_DISK OR AFF_SCALED OR AFF_TAGGED)
  139.     REPEAT
  140.       afh:=NewR(afsize)
  141.       afshortage:=AvailFonts(afh, afsize,
  142.                           AFF_MEMORY OR AFF_DISK OR AFF_SCALED OR AFF_TAGGED)
  143.       IF afshortage
  144.         Dispose(afh)
  145.         afsize:=afsize+afshortage
  146.         afh:=-1
  147.       ENDIF
  148.     UNTIL afshortage=0
  149.  
  150.     -> This is for the layers.library clipping region that gets attached to
  151.     -> the window.  This prevents the application from unnecessarily rendering
  152.     -> beyond the bounds of the inner part of the window. For more information
  153.     -> on clipping, see the Layers chapter of the RKRM.
  154.     new_region:=NewRegion()  -> More layers stuff
  155.     IF OrRectRegion(new_region, myrect)  -> Even more layers stuff
  156.       -> Obtain a pointer to the window's rastport and set up some of the
  157.       -> rastport attributes.  This example obtains the text pen for the
  158.       -> window's screen using the GetScreenDrawInfo() function.
  159.       mycliprp:=mywin.rport
  160.       SetAPen(mycliprp, mydrawinfo.pens[TEXTPEN])
  161.       mainLoop()
  162.     ENDIF
  163.   ENDIF
  164. EXCEPT DO
  165.   IF new_region THEN DisposeRegion(new_region)
  166.   IF afh THEN Dispose(afh)
  167.   -> E-Note: C version forgets to CloseFont()
  168.   IF defaultfont THEN CloseFont(defaultfont)
  169.   IF mydrawinfo THEN FreeScreenDrawInfo(mywin.wscreen, mydrawinfo)
  170.   IF mywin THEN CloseWindow(mywin)
  171.   IF utilitybase THEN CloseLibrary(utilitybase)
  172.   IF layersbase THEN CloseLibrary(layersbase)
  173.   IF diskfontbase THEN CloseLibrary(diskfontbase)
  174.   SELECT exception
  175.   CASE ERR_DRAW;  WriteF('Error: could not get drawinfo from screen\n')
  176.   CASE ERR_LIB;   WriteF('Error: could not open required library\n')
  177.   CASE ERR_REGN;  WriteF('Error: could not allocate new region\n')
  178.   CASE ERR_WIN;   WriteF('Error: could not open window\n')
  179.   CASE "MEM";     WriteF('Error: ran out of memory\n')
  180.   ENDSELECT
  181. ENDPROC
  182. ->>>
  183.  
  184. ->>> PROC mainLoop()
  185. PROC mainLoop()
  186.   DEF x, mymsg:PTR TO intuimessage, aok=TRUE, afont:PTR TO taf,
  187.       myfont:PTR TO textfont, buf[8]:STRING, dpi
  188.  
  189.   -> E-Note: task data not needed since we can use CtrlC()
  190.   afont:=afh+SIZEOF afh
  191.  
  192.   FOR x:=0 TO afh.numentries-1
  193.     IF aok
  194.       IF myfont:=OpenDiskFont(afont.attr)
  195.         -> Print the TextFont attributes.
  196.         SetAPen(myrp, mydrawinfo.pens[BACKGROUNDPEN])
  197.         RectFill(myrp, stringwidth, mywin.bordertop+4,
  198.                  mywin.width-(mywin.borderright+1), myrect.miny-2)
  199.  
  200.         SetAPen(myrp, mydrawinfo.pens[TEXTPEN])
  201.         Move(myrp, stringwidth+mywin.borderleft,
  202.              mywin.bordertop+4+myrp.font.baseline)
  203.         Text(myrp, myfont.mn.ln.name, StrLen(myfont.mn.ln.name))
  204.  
  205.         -> Print the font's Y Size.
  206.         Move(myrp, stringwidth+mywin.borderleft, myrp.cp_y+fontheight)
  207.         StringF(buf, '\d', myfont.ysize)
  208.         Text(myrp, buf, StrLen(buf))
  209.  
  210.         -> Print the X DPI
  211.         Move(myrp, stringwidth+mywin.borderleft, myrp.cp_y+fontheight)
  212.         dpi:=GetTagData(TA_DEVICEDPI, 0,
  213.                         myfont.mn.replyport::textfontextension.tags)
  214.         IF dpi
  215.           StringF(buf, '\d', Shr(dpi AND $FFFF0000, 16))
  216.           Text(myrp, buf, StrLen(buf))
  217.         ELSE
  218.           Text(myrp, 'NIL', 3)
  219.         ENDIF
  220.  
  221.         -> Print the Y DPI
  222.         Move(myrp, stringwidth+mywin.borderleft, myrp.cp_y+fontheight)
  223.         IF dpi
  224.           StringF(buf, '\d', dpi AND $0000FFFF)
  225.           Text(myrp, buf, StrLen(buf))
  226.         ELSE
  227.           Text(myrp, 'NIL', 3)
  228.         ENDIF
  229.  
  230.         -> Print the entrynum
  231.         Move(myrp, stringwidth+mywin.borderleft, myrp.cp_y+fontheight)
  232.         StringF(buf, '\d', x)
  233.         Text(myrp, buf, StrLen(buf))
  234.  
  235.         SetFont(mycliprp, myfont)
  236.         -> Install clipping rectangle
  237.         old_region:=InstallClipRegion(mywin.wlayer, new_region)
  238.  
  239.         SetRast(mycliprp, mydrawinfo.pens[BACKGROUNDPEN])
  240.         Move(mycliprp, myrect.minx,
  241.              myrect.maxy-(myfont.ysize-myfont.baseline))
  242.         Text(mycliprp, alphabetstring, alphabetcharcount)
  243.  
  244.         Delay(100)
  245.  
  246.         -> Remove clipping rectangle
  247.         new_region:=InstallClipRegion(mywin.wlayer, old_region)
  248.  
  249.         WHILE mymsg:=GetMsg(mywin.userport)
  250.           aok:=FALSE
  251.           x:=afh.numentries
  252.           ReplyMsg(mymsg)
  253.         ENDWHILE
  254.  
  255.         -> Did the user hit Ctrl-C?
  256.         IF CtrlC()
  257.           aok:=FALSE
  258.           x:=afh.numentries
  259.           WriteF('Ctrl-C Break\n')
  260.         ENDIF
  261.         CloseFont(myfont)
  262.       ENDIF
  263.     ENDIF
  264.     afont++
  265.   ENDFOR
  266. ENDPROC
  267. ->>>
  268.  
  269. ->>> Version string
  270. vers:
  271.   CHAR 0, '$VER: AvailFonts 36.3', 0
  272. ->>>
  273.